unit ExIniFile;

interface

uses
{$IFDEF WIN32}
   Windows,
   {$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}
  Classes, SysUtils, IniFiles, Variants;


type
  TExIniFile = class(TCustomIniFile)
  private
    FIni: TStringList;
    FFile:Cardinal;
    FFileName : string;
    FFileComment : TStringList;
    FAutoUpdate : Boolean;
    FLockFile:Boolean;
    FTextMode: Boolean;
    FModified:Boolean;
    procedure SetFileLocked(const Value: boolean);
    function GetCaseSensitive: Boolean;
    procedure SetCaseSensitive(Value: Boolean);
    function GetAttribs: integer;
    procedure SetAttribs(const Value: integer);
  protected
    procedure ReLockFile(const NewName:string);
    procedure UnlockFile();
    procedure LoadValues();
    procedure LoadFile(List:TStringList; Handle:cardinal);
    function  TextToIni(const Text:string):string;
    function  IniToText(const IniText:string):string;
    procedure CheckBoolArr();
    procedure ListSections(List:TStrings);
    procedure ListNames(const Section:string; List:TStrings);
    procedure ListValues(const Section:string; List:TStrings);
    procedure ListItems(const Section:string; List:TStrings);
    function  FindSection(const Section:string):integer;
    function  FindIdentifier(const Section, Ident:string):integer;
    procedure FindValues(const Section, Ident:string; var SectionIndex, IdentIndex:integer);
    function  IniLastIndex(SectionIndex:integer):integer;
  public
    constructor Create(const FileName: string; LockFile:Boolean; UpdateAtDestroy:Boolean = True);
    destructor Destroy; override;
    procedure UpdateFile; override;
    procedure Clear();
    procedure GetStrings(List: TStrings);
    procedure DeleteKey(const Section, Ident: String); override;
    procedure EraseSection(const Section: string); override;
    procedure Rename(const FileName: string; Reload: Boolean);
    procedure ReadSection(const Section: string; Strings: TStrings); override;
    procedure ReadSections(Strings: TStrings); override;
    procedure ReadSectionValues(const Section: string; Strings: TStrings); override;
    procedure ReadSectionItems(const Section: string; Strings: TStrings);
    function  ReadString(const Section, Ident, Default: string): string; override;
    procedure WriteString(const Section, Ident, Value: String); override;
    function  ReadBool(const Section, Ident: string; Default: Boolean): Boolean; override;
    procedure WriteBool(const Section, Ident: string; Value: Boolean); override;
    procedure SetStrings(List: TStrings);
    procedure ReadMultiLine(const Section, Ident: string; MultiLine:TStrings);
    procedure WriteMultiLine(const Section, Ident: string; MultiLine:TStrings);

    property FileLocked:boolean read FLockFile write SetFileLocked;
    property FileName:string read FFileName;
    property TextMode:Boolean read FTextMode write FTextMode;
    property FileComment:TStringList read FFileComment;
    property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
    property FileAttribs:integer read GetAttribs write SetAttribs;
  end;

var
   _Ini_new_line_str : string = '\n';
   _text_new_line    : string = #13#10;

   _true_str         : string = 'True';
   _false_str        : string = 'False';

   _comment_chars    : string   = '#;';
   _default_comment_char : char = {$IFDEF LINUX} '#' {$ELSE} ';' {$ENDIF};


implementation

{ TExIniFile }

var
  bool_arr : array[boolean] of string;


constructor TExIniFile.Create(const FileName: string; LockFile:Boolean; UpdateAtDestroy: Boolean);
begin
  FFileName   := FileName;
  FAutoUpdate := UpdateAtDestroy;
  FLockFile   := LockFile;
  FFile       := 0;
  FModified   := False;
  FFileComment := TStringList.Create;  
  FIni         := TStringList.Create;
  if LockFile then
    ReLockFile(FileName);
  inherited Create(FileName);
  LoadValues();
end;

destructor TExIniFile.Destroy;
begin
  if FAutoUpdate and FModified then
    UpdateFile();
  if FFile <> 0 then
    FileClose(FFile);
  FFileComment.Free;
  FIni.Free;
  inherited Destroy;
end;

procedure TExIniFile.Clear;
begin
  if FFile = 0 then
    begin
      FIni.Clear;
      Exit;
    end;
  FileSeek(FFIle, 0, 0);
  {$IFDEF MSWINDOWS}
   Win32Check(SetEndOfFile(FFile));
  {$ELSE}
  if ftruncate(FFile, 0) = -1 then
    raise EStreamError(sStreamSetSize);
  {$ENDIF}
end;

procedure TExIniFile.LoadValues;
var
  List: TStringList;

  procedure GetComment();
  var
    i, ll:integer;
    s:string;
  begin
    ll := 0;
    for i:=0 to List.Count - 1 do
      begin
        s := Trim(List[i]);
        if (s <> '') and (s[1] ='[') and (s[length(s)] = ']') then
          begin
            if i = 0 then
              exit;
            ll := i + 1;
            break;
          end;
      end;
    for i:=0 to ll - 2 do
      begin
        s := Trim(List[i]);
        if (s <> '') and (pos(s[1], _comment_chars) > 0 ) then
          Delete(s, 1, 1);
        FileComment.Add(S);
      end;
    for i:=0 to ll - 2 do
      List.Delete(0);
  end;


begin
  FileComment.Clear;
  if (FileName <> '') and FileExists(FileName) then
  begin
    List := TStringList.Create;
    try
      if FLockFile then
        begin
          LoadFile(List, FFile);
        end
          else
        List.LoadFromFile(FileName);
      GetComment();
      SetStrings(List);
    finally
      List.Free;
    end;
  end
  else
    Clear;
end;

procedure TExIniFile.ReLockFile(const NewName: string);
begin
  UnlockFile();
  if FileExists(NewName) then
    FFile := FileOpen(NewName, fmOpenReadWrite or fmShareDenyWrite);
end;

procedure TExIniFile.Rename(const FileName: string; Reload: Boolean);
begin
  FFileName := FileName;
  UnlockFile();
  if FLockFile then
    ReLockFile(FileName);
  if Reload then
    LoadValues();
end;

procedure TExIniFile.SetFileLocked(const Value: boolean);
begin
  if Value then
    ReLockFile(FFileName)
      else
    UnlockFile();
  FLockFile := Value;
end;

function TExIniFile.TextToIni(const Text: string): string;
begin
  Result := StringReplace(Text, _text_new_line, _ini_new_line_str, [rfReplaceAll]);
end;

procedure TExIniFile.UnlockFile;
begin
  if FFile <> 0 then
    begin
      FileClose(FFile);
      FFile := 0;
    end;
end;

procedure TExIniFile.UpdateFile;
var
  attr, i:integer;
  a_ini:TStringList;
begin
  attr  := FileAttribs;
  a_ini := TStringList.Create;
  try
    for i:=0 to FileComment.Count - 1 do
      a_ini.Add(_default_comment_char + FileComment[i]);
    a_ini.AddStrings(fini);
    FileAttribs := 0;
    if not FLockFile or (FFile = 0) then
      begin
        a_ini.SaveToFile(FFileName);
      end
        else
      begin
        Clear();
        FileSeek(FFile, 0, 0);
        FileWrite(FFile, a_ini.Text[1], Length(a_ini.Text));
      end;
    FModified := False;
  finally
    a_ini.Free;
    FileAttribs := attr;
  end;
end;

function TExIniFile.IniToText(const IniText: string): string;
begin
  Result := StringReplace(IniText, _ini_new_line_str , _text_new_line, [rfReplaceAll]);
end;

function TExIniFile.ReadString(const Section, Ident,
  Default: string): string;
var
  I, q: Integer;
begin
  I := FindIdentifier(Section, Ident);
  if I = -1 then
    begin
      Result := Default;
    end
  else
    begin
      q := Pos('=', FIni[I]);
      Result := Copy(FIni[I], q + 1, MaxInt);
      if TextMode then
        Result := IniToText(Result);
    end;
end;

procedure TExIniFile.WriteString(const Section, Ident, Value: String);
var
  sec, idx: Integer;
  S: string;
begin
  FindValues(Section, Ident, sec, idx);
  FModified := True;
  if TextMode then
    S := TextToIni(Value)
  else
    S := Value;
  S := Ident + '=' + S;
  if sec = -1 then
    begin
      if FIni.Count > 0 then
        if FIni[FIni.Count - 1] <> '' then
          FIni.Add('');
      FIni.Add('[' + Section + ']');
      FIni.Add(S);
    end
  else
    begin
      if idx <> - 1 then
        begin
          FIni[idx] := S;
        end
      else
        FIni.Insert(IniLastIndex(sec){ + 1}, S);
    end;
end;

function TExIniFile.ReadBool(const Section, Ident: string;
  Default: Boolean): Boolean;
var
  tmp:string;
begin
  CheckBoolArr();
  tmp := ReadString(Section, Ident, bool_arr[Default]);
  Result := LowerCase(tmp) = LowerCase(bool_arr[True]);
end;

procedure TExIniFile.WriteBool(const Section, Ident: string;
  Value: Boolean);
begin
  CheckBoolArr();
  WriteString(Section, Ident, bool_arr[Value]);
end;

procedure TExIniFile.CheckBoolArr;
begin
  bool_arr[False] := _false_str;
  bool_arr[True]  := _true_str;
end;

procedure TExIniFile.LoadFile(List: TStringList; Handle: cardinal);
var
  size:integer;
  buffer:string;

  function FileSize():Integer;
  begin
    Result := FileSeek(FFile, 0, 2);
  end;

begin
  size := FileSize();
  FileSeek(Handle, 0, 0);
  SetLength(buffer, Size);
  FileRead(Handle, buffer[1], Size);
  List.Text := buffer;
end;

procedure TExIniFile.SetStrings(List: TStrings);
begin
  FIni.Assign(List);
end;

function TExIniFile.GetCaseSensitive: Boolean;
begin
  Result := FIni.CaseSensitive;
end;

procedure TExIniFile.SetCaseSensitive(Value: Boolean);
begin
  FIni.CaseSensitive := Value;
end;

procedure TExIniFile.DeleteKey(const Section, Ident: String);
var
  I, J: Integer;
begin
  FindValues(Section, Ident, I, J);
  if (I <> -1) and (J <> -1) then
    begin
      FIni.Delete(J);
    end;
end;

procedure TExIniFile.EraseSection(const Section: string);
var
  I, J: Integer;
  S:string;
begin
  I := FindSection(Section);
  if (I <> -1) then
    begin
      FModified := True;
      J := I + 1;
      while J < Fini.Count do
        begin
          S := Trim(FIni[J]);
          if (S <> '') and (S[1] = '[') and (S[Length(S)] = ']') then
            Break;
          FIni.Delete(J);  
        end;
      FIni.Delete(I);
    end;
end;

procedure TExIniFile.GetStrings(List: TStrings);
begin
  List.Assign(FIni);
end;

procedure TExIniFile.ReadSection(const Section: string; Strings: TStrings);
begin
  ListNames(Section, Strings); 
end;

procedure TExIniFile.ReadSections(Strings: TStrings);
begin
  ListSections(Strings);
end;

procedure TExIniFile.ReadSectionValues(const Section: string;
  Strings: TStrings);
begin
  ListValues(Section, Strings);
end;

procedure TExIniFile.ListSections(List: TStrings);
var
  i:integer;
  S:string;
begin
  List.Clear;
  for i:=0 to Fini.Count - 1 do
    begin
      S  := Trim(fini[i]);
      if (S <> '') and (S[1] = '[') and (S[Length(S)] = ']') then
        List.AddObject(Copy(S, 2, Length(S) - 2 ), TObject(I));
    end;
end;

procedure TExIniFile.ListValues(const Section: string; List: TStrings);
var
  i, idx, x:integer;
  S:string;
  sec:string;
begin
  List.Clear;
  idx := FindSection(Section);
  if idx > -1 then
    begin
      if not CaseSensitive then
        sec := LowerCase(Section);
      for i := idx + 1 to Fini.Count - 1 do
        begin
          S := Trim(fini[i]);
          x := pos('=', S);
          if x > 0 then
            begin
              List.AddObject(Copy(S, x + 1, MaxInt), TObject(i));
            end;
          if (S <> '') and (S[1] = '[') and (S[Length(S)] = ']') then
            Break;
        end;
    end;
end;

function TExIniFile.FindIdentifier(const Section, Ident: string): integer;
var
  i:integer;
begin
  FindValues(Section, Ident, i, Result);
end;

function TExIniFile.FindSection(const Section:string): integer;
begin
  FIni.CaseSensitive := CaseSensitive;
  Result := FIni.IndexOf('[' + Section + ']');
end;

procedure TExIniFile.ListNames(const Section: string; List: TStrings);
var
  i, idx, x:integer;
  S:string;
  sec:string;
begin
  List.Clear;
  idx := FindSection(Section);
  if idx > -1 then
    begin
      if not CaseSensitive then
        sec := LowerCase(Section);
      for i := idx + 1 to Fini.Count - 1 do
        begin
          S := Trim(fini[i]);
          x := pos('=', S);
          if x > 0 then
            begin
              List.AddObject(copy(S, 1, x - 1), TObject(i));
            end;
          if (S <> '') and (S[1] = '[') and (S[Length(S)] = ']') then
            Break;
        end;
    end;
end;

procedure TExIniFile.FindValues(const Section, Ident: string;
  var SectionIndex, IdentIndex: integer);
var
  i:integer;
  S:string;
  idn:string;
begin
  SectionIndex := FindSection(Section);
  IdentIndex   := -1;
  if SectionIndex > -1 then
    begin
      if not CaseSensitive then
        idn := LowerCase(Ident);
      for i := SectionIndex + 1 to Fini.Count - 1 do
        begin
          S := Trim(fini[i]);
          if not CaseSensitive then
            S := LowerCase(S);
          if Pos(idn, S) = 1 then
            begin
              IdentIndex := i;
              Break;
            end;
          if (S <> '') and (S[1] = '[') and (S[Length(S)] = ']') then
            Break;
        end;
    end;
end;

procedure TExIniFile.ListItems(const Section: string; List: TStrings);
var
  i, idx, x:integer;
  S:string;
  sec:string;
begin
  List.Clear;
  idx := FindSection(Section);
  if idx > -1 then
    begin
      if not CaseSensitive then
        sec := LowerCase(Section);
      for i := idx + 1 to Fini.Count - 1 do
        begin
          S := Trim(fini[i]);
          x := pos('=', S);
          if x > 0 then
            begin
              List.AddObject(copy(S, 1, x - 1) + '=' + Copy(S, x + 1, MaxInt), TObject(i));
            end;
          if (S <> '') and (S[1] = '[') and (S[Length(S)] = ']') then
            Break;
        end;
    end;
end;

procedure TExIniFile.ReadSectionItems(const Section: string;
  Strings: TStrings);
begin
  ListItems(Section, Strings);
end;

function TExIniFile.GetAttribs: integer;
begin
  {$IFDEF MSWINDOWS}
    Result := FileGetAttr(FileName);
    if Cardinal(Result) = $FFFFFFFF then
      Result := FILE_ATTRIBUTE_NORMAL;
  {$ELSE}
    DoAcessException();
  {$ENDIF}
end;

procedure TExIniFile.SetAttribs(const Value: integer);
begin
  {$IFDEF MSWINDOWS}
    FileSetAttr(FileName, Value);
  {$ELSE}
    DoAcessException();
  {$ENDIF}
end;

function TExIniFile.IniLastIndex(SectionIndex:integer): integer;
var
  i:integer;
  sec:string;
begin
  Result := SectionIndex;
    for i:= Result + 1 to fini.Count - 1 do
      begin
        Result := i;
        sec := Trim(fini[i]);
        if sec = '' then
          exit;
        if (sec <> '') and (sec[1] ='[') then
          begin
            Dec(Result);
            exit;
          end;
      end;
  inc(Result);    
end;

procedure TExIniFile.ReadMultiLine(const Section, Ident: string;
  MultiLine: TStrings);
var
  i, x :integer;
  s:string;
begin
  ListItems(Section, MultiLine);
  i := 0;
  while (i < MultiLine.Count) do
    begin
      S := Trim(MultiLine[i]);
      x := pos('=', S);
      if not AnsiSameStr(Copy(S, 1, x - 1), Ident) then
        MultiLine.Delete(i)
      else
        begin
          MultiLine[i] := Copy(S, x + 1, MaxInt);
          inc(i);
        end;  
    end;
end;

procedure TExIniFile.WriteMultiLine(const Section, Ident: string;
  MultiLine: TStrings);
var
  sec, idx, i, x: Integer;
  S: string;
begin
  FindValues(Section, Ident, sec, idx);
  FModified := True;
  if sec <> -1 then
    begin
      i := sec + 1;
      if i < fini.Count then
        repeat
          S := Trim(fini[i]);
          x := pos('=', S);
          if AnsiSameStr(Copy(S, 1, x - 1), Ident) then
            fini.Delete(i)
          else
            inc(i);
        until ((S <> '') and (S[1] = '[') and (S[Length(S)] = ']') or (i >= fini.count));
    end;
  if not Assigned(multiline) then
    exit;
  for i:=0 to MultiLine.Count - 1 do
    begin
      if TextMode then
        S := TextToIni(MultiLine[i])
      else
        S := MultiLine[i];
      S := Ident + '=' + S;
      if sec = -1 then
        begin
          if FIni.Count > 0 then
            if FIni[FIni.Count - 1] <> '' then
              FIni.Add('');
          FIni.Add('[' + Section + ']');
          sec := FIni.Add(S);
        end
      else
        begin
          FIni.Insert(sec+1+i, S);
        end;
  end;  
end;

end.
